home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / lapack / dlarf.f < prev    next >
Text File  |  1996-07-19  |  3KB  |  117 lines
  1.       SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
  2. *
  3. *  -- LAPACK auxiliary routine (version 2.0) --
  4. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  5. *     Courant Institute, Argonne National Lab, and Rice University
  6. *     February 29, 1992
  7. *
  8. *     .. Scalar Arguments ..
  9.       CHARACTER          SIDE
  10.       INTEGER            INCV, LDC, M, N
  11.       DOUBLE PRECISION   TAU
  12. *     ..
  13. *     .. Array Arguments ..
  14.       DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
  15. *     ..
  16. *
  17. *  Purpose
  18. *  =======
  19. *
  20. *  DLARF applies a real elementary reflector H to a real m by n matrix
  21. *  C, from either the left or the right. H is represented in the form
  22. *
  23. *        H = I - tau * v * v'
  24. *
  25. *  where tau is a real scalar and v is a real vector.
  26. *
  27. *  If tau = 0, then H is taken to be the unit matrix.
  28. *
  29. *  Arguments
  30. *  =========
  31. *
  32. *  SIDE    (input) CHARACTER*1
  33. *          = 'L': form  H * C
  34. *          = 'R': form  C * H
  35. *
  36. *  M       (input) INTEGER
  37. *          The number of rows of the matrix C.
  38. *
  39. *  N       (input) INTEGER
  40. *          The number of columns of the matrix C.
  41. *
  42. *  V       (input) DOUBLE PRECISION array, dimension
  43. *                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
  44. *                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
  45. *          The vector v in the representation of H. V is not used if
  46. *          TAU = 0.
  47. *
  48. *  INCV    (input) INTEGER
  49. *          The increment between elements of v. INCV <> 0.
  50. *
  51. *  TAU     (input) DOUBLE PRECISION
  52. *          The value tau in the representation of H.
  53. *
  54. *  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
  55. *          On entry, the m by n matrix C.
  56. *          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
  57. *          or C * H if SIDE = 'R'.
  58. *
  59. *  LDC     (input) INTEGER
  60. *          The leading dimension of the array C. LDC >= max(1,M).
  61. *
  62. *  WORK    (workspace) DOUBLE PRECISION array, dimension
  63. *                         (N) if SIDE = 'L'
  64. *                      or (M) if SIDE = 'R'
  65. *
  66. *  =====================================================================
  67. *
  68. *     .. Parameters ..
  69.       DOUBLE PRECISION   ONE, ZERO
  70.       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  71. *     ..
  72. *     .. External Subroutines ..
  73.       EXTERNAL           DGEMV, DGER
  74. *     ..
  75. *     .. External Functions ..
  76.       LOGICAL            LSAME
  77.       EXTERNAL           LSAME
  78. *     ..
  79. *     .. Executable Statements ..
  80. *
  81.       IF( LSAME( SIDE, 'L' ) ) THEN
  82. *
  83. *        Form  H * C
  84. *
  85.          IF( TAU.NE.ZERO ) THEN
  86. *
  87. *           w := C' * v
  88. *
  89.             CALL DGEMV( 'Transpose', M, N, ONE, C, LDC, V, INCV, ZERO,
  90.      $                  WORK, 1 )
  91. *
  92. *           C := C - v * w'
  93. *
  94.             CALL DGER( M, N, -TAU, V, INCV, WORK, 1, C, LDC )
  95.          END IF
  96.       ELSE
  97. *
  98. *        Form  C * H
  99. *
  100.          IF( TAU.NE.ZERO ) THEN
  101. *
  102. *           w := C * v
  103. *
  104.             CALL DGEMV( 'No transpose', M, N, ONE, C, LDC, V, INCV,
  105.      $                  ZERO, WORK, 1 )
  106. *
  107. *           C := C - w * v'
  108. *
  109.             CALL DGER( M, N, -TAU, WORK, 1, V, INCV, C, LDC )
  110.          END IF
  111.       END IF
  112.       RETURN
  113. *
  114. *     End of DLARF
  115. *
  116.       END
  117.